home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / BBS_UTL / DDPLUS71 / DDANSI2.PAS < prev    next >
Pascal/Delphi Source File  |  1995-05-12  |  9KB  |  294 lines
  1. unit ddansi2;
  2.  
  3. interface
  4.  
  5. uses dos, crt;
  6. {----------------------------------------------------------------------------}
  7. {                       Ansi screen emulation routines                       }
  8. {                              By Scott Baker                                }
  9. {                        Revised By Derrick Parkhurst
  10. {----------------------------------------------------------------------------}
  11. {                                                                            }
  12. { Purpose: to execute ansi escape sequences locally. This includes changing  }
  13. {          color, moving the cursor, setting high/low intensity, setting     }
  14. {          blinking, and playing music.                                      }
  15. {                                                                            }
  16. { Remarks: These routines use a few global variables which are defined       }
  17. {          below. So far, only ESC m, J, f, C, and ^N are supported by these }
  18. {          routines. I hope to include more in the future.                   }
  19. {                                                                            }
  20. { Routines: Here is a listing of the subroutines:                            }
  21. {                                                                            }
  22. {             change_color(x):      Change to ansi color code X.             }
  23. {             Eval_string(s):       Evaluate/execute ansi string             }
  24. {             ansi_write(ch):       Write a character with ansi checking     }
  25. {                                                                            }
  26. {----------------------------------------------------------------------------}
  27.  
  28. var
  29.  escape,blink,high,norm,any,any2,fflag,gflag: boolean;
  30.  ansi_string: string;
  31. const
  32.  ddansibanner: boolean = true;
  33.  
  34. procedure ansi_write(ch: char);
  35. procedure ansi_write_str(var s: string);
  36. procedure initddansi;
  37.  
  38. implementation
  39.  
  40. const
  41.  scale: array[0..7] of integer = (0,4,2,6,1,5,3,7);
  42.  scaleh: array[0..7] of integer = (8,12,10,14,9,13,11,15);
  43. var
  44.  bbb: boolean;
  45.  t: char;
  46.  restx,resty,curcolor: integer;
  47.  Note_Octave: integer;
  48.  Note_Fraction, Note_Length, Note_Quarter: real;
  49.  
  50. procedure change_color(c: integer);
  51. begin;
  52.  case c of
  53.   00: begin;any:=true;blink:=false;high:=false;norm:=true;end;
  54.   01: begin;high:=true;end;
  55.   02: begin;clrscr;any:=true;end;
  56.   05: begin;blink:=true;any:=true;end;
  57.  end;
  58.  if (c>29) and (c<38) then begin;
  59.   any:=true;
  60.   any2:=true;
  61.   c:=c-30;
  62.   curcolor:=c;
  63.   if (high=true) and (blink=true) then textcolor(scaleh[c]+32);
  64.   if (high=true) and (blink=false) then textcolor(scaleh[c]);
  65.   if (high=false) and (blink=true) then textcolor(scale[c]+32);
  66.   if (high=false) and (blink=false) then textcolor(scale[c]);
  67.   fflag:=true;
  68.  end;
  69.  if (c>39) and (c<48) then begin;
  70.   any:=true;
  71.   c:=c-40;
  72.   textbackground(scale[c]);
  73.   gflag:=true;
  74.  end;
  75. end;
  76.  
  77. procedure eval_string(var s: string);
  78. var
  79.  cp: integer;
  80.  T: CHAR;
  81.  b:byte;
  82.  jj,a,ttt,tttt: integer;
  83.  flag1:boolean;
  84. begin;
  85.  t:=s[length(s)];
  86.  cp:=2;
  87.  case t of
  88.   'k','K': clreol;
  89.   'u': gotoxy(restx,resty);
  90.   's': begin;
  91.         restx:=wherex;
  92.         resty:=wherey;
  93.        end;
  94.   'm','J':begin;
  95.            repeat;
  96.             a:=-1;
  97.             val(s[cp],a,tttt);
  98.             if tttt=0 then begin;
  99.              cp:=cp+1;
  100.              val(s[cp],ttt,tttt);
  101.              if tttt=0 then begin;
  102.               a:=a*10;
  103.               a:=a+ttt;
  104.              end;
  105.              change_color(a);
  106.             end;
  107.             cp:=cp+1;
  108.            until cp>=length(s);
  109.            if norm then begin;
  110.              if (fflag=false) and (gflag=false) then begin;textcolor(7);textbackground(0);curcolor:=7;end;
  111.              if (fflag=false) and (gflag=true) then begin;textcolor(7);curcolor:=7;end;
  112.              if (high=true) and (fflag=false) then textcolor(scaleh[curcolor]);
  113.              if (blink=true) and (fflag=false) then textcolor(scale[curcolor]+32);
  114.              if (blink=true) and (high=true) and (fflag=false) then textcolor(scaleh[curcolor]+32);
  115.              if (fflag=true) and (gflag=false) then begin;textbackground(0);end;
  116.             end;
  117.            if any=false then textcolor(scaleh[curcolor]);
  118. { 5/12/95 srl }
  119.            if (any2=false)  then
  120.              if (high=true) then
  121.                begin
  122.                  if (blink=true) then
  123.                    textcolor(scaleh[curcolor]+32)
  124.                  else
  125.                    textcolor(scaleh[curcolor]);
  126.                end
  127.              else
  128.              if (blink=true) then textcolor(scale[curcolor]+32);
  129.  
  130.            any2:=false;any:=false;fflag:=false;gflag:=false;norm:=false;
  131.          end;
  132.    'C': begin;
  133.             a:=1;
  134.             val(s[cp],a,tttt);
  135.             if tttt=0 then begin;
  136.              cp:=cp+1;
  137.              val(s[cp],ttt,tttt);
  138.              if tttt=0 then begin;
  139.               a:=a*10;
  140.               a:=a+ttt;
  141.              end;
  142.             end else a:=1;
  143.             ttt:=wherex;
  144.             if a+ttt<=80 then gotoxy(a+ttt,wherey);
  145.            end;
  146.    'D': begin;
  147.             a:=1;
  148.             val(s[cp],a,tttt);
  149.             if tttt=0 then begin;
  150.              cp:=cp+1;
  151.              val(s[cp],ttt,tttt);
  152.              if tttt=0 then begin;
  153.               a:=a*10;
  154.               a:=a+ttt;
  155.              end;
  156.             end else a:=1;
  157.             ttt:=wherex;
  158.             if ttt-a>=1 then gotoxy(ttt-a,wherey);
  159.            end;
  160.    'A': begin;
  161.             a:=1;
  162.             val(s[cp],a,tttt);
  163.             if tttt=0 then begin;
  164.              cp:=cp+1;
  165.              val(s[cp],ttt,tttt);
  166.              if tttt=0 then begin;
  167.               a:=a*10;
  168.               a:=a+ttt;
  169.              end;
  170.             end else a:=1;
  171.             ttt:=wherey;
  172.             if ttt-a>=1 then gotoxy(wherex,ttt-a);
  173.            end;
  174.    'B': begin;
  175.             a:=1;
  176.             val(s[cp],a,tttt);
  177.             if tttt=0 then begin;
  178.              cp:=cp+1;
  179.              val(s[cp],ttt,tttt);
  180.              if tttt=0 then begin;
  181.               a:=a*10;
  182.               a:=a+ttt;
  183.              end;
  184.             end else a:=1;
  185.             ttt:=wherey;
  186.             if ttt+a<=25 then gotoxy(wherex,ttt+a);
  187.            end;
  188.   'f','H': begin;
  189.            flag1:=false;
  190.            a:=1;
  191.             val(s[cp],a,tttt);
  192.             if tttt=0 then begin;
  193.              cp:=cp+1;
  194.              val(s[cp],ttt,tttt);
  195.              if tttt=0 then begin;
  196.               a:=a*10;
  197.               a:=a+ttt;
  198.               flag1:=true;
  199.              end;
  200.             end else a:=1;
  201.             jj:=a;
  202.             if flag1=false then cp:=cp+1;
  203.             if flag1=true then cp:=cp+2;
  204.             if cp<length(s) then begin;
  205.             a:=1;
  206.             val(s[cp],a,tttt);
  207.             if tttt=0 then begin;
  208.              cp:=cp+1;
  209.              val(s[cp],ttt,tttt);
  210.              if tttt=0 then begin;
  211.               a:=a*10;
  212.               a:=a+ttt;
  213.              end;
  214.             end else a:=1;
  215.            end else a:=1;
  216.           gotoxy(a,jj);
  217.        end;
  218.   else writeln(s);
  219.  end;
  220. end;
  221.  
  222. Procedure ansi_write(ch: char);
  223. begin;
  224.   case ch of
  225.    #12: clrscr;
  226.    #09: repeat; write(' '); until wherex/8 = wherex div 8;
  227.    #27: begin; escape:=true; bbb:=true; end;
  228.  
  229.    else begin;
  230.     if escape then begin;
  231.      if (bbb=true) and (ch<>'[') then begin;
  232.       blink:=false;
  233.       high:=false;
  234.       escape:=false;
  235.       ansi_string:='';
  236.       write(#27);
  237.      end else bbb:=false;
  238.      if escape then begin;
  239.       ansi_string:=ansi_string+ch;
  240.       if ch=#13 then escape:=false;
  241.       if (ch in ['u','s','A','B','C','D','H','m','J','f','K','k',#14]) then begin;
  242.        escape:=false;
  243.        eval_string(ansi_string);
  244.        ansi_string:='';
  245.       end;
  246.      end;
  247.     end else write(ch);
  248.    end;
  249.   end;
  250. end;
  251.  
  252. Procedure ansi_write_str(var s: string);
  253. var
  254.  a: integer;
  255. begin;
  256.  for a:=1 to length(s) do begin;
  257.   case s[a] of
  258.    #12: clrscr;
  259.    #09: repeat; write(' '); until wherex/8 = wherex div 8;
  260.    #27: begin; escape:=true; bbb:=true; end;
  261.  
  262.    else begin;
  263.     if escape then begin;
  264.      if (bbb=true) and (s[a]<>'[') then begin;
  265.       blink:=false;
  266.       high:=false;
  267.       escape:=false;
  268.       ansi_string:='';
  269.       write(#27);
  270.      end else bbb:=false;
  271.      if escape then begin;
  272.       ansi_string:=ansi_string+s[a];
  273.       if s[a]=#13 then escape:=false;
  274.       if (s[a] in ['u','s','A','B','C','D','H','m','J','f','K','k',#14]) then begin;
  275.        escape:=false;
  276.        eval_string(ansi_string);
  277.        ansi_string:='';
  278.       end;
  279.      end;
  280.     end else write(s[a]);
  281.    end;
  282.   end;
  283.  end;
  284. end;
  285.  
  286. procedure InitDDAnsi;
  287. begin;
  288.  escape:=false;
  289.  ansi_string:='';
  290.  blink:=false;
  291.  high:=false;
  292. end;
  293.  
  294. end.